Hardcore Visual Basic 5.0 (2nd Edition)/Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso/Code/TTimer.frm

Text File | 1997-06-14 | 4KB | 170 lines

VERSION 5.00
Begin VB.Form FTestTimer
   Caption         =   "Test Timer"
   ClientHeight    =   4470
   ClientLeft      =   1920
   ClientTop       =   3105
   ClientWidth     =   5445
   Icon            =   "TTimer.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4470
   ScaleWidth      =   5445
   Begin VB.TextBox txtSec
      Height          =   348
      Left            =   156
      TabIndex        =   2
      Text            =   "2"
      Top             =   1008
      Width           =   1176
   End
   Begin VB.TextBox txtOut
      Height          =   4092
      Left            =   1620
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   228
      Width           =   3648
   End
   Begin VB.CommandButton cmdStart
      Caption         =   "New Timer"
      Height          =   396
      Left            =   156
      TabIndex        =   0
      Top             =   216
      Width           =   1200
   End
   Begin VB.Label lbl
      Caption         =   "Delay in seconds:"
      Height          =   204
      Left            =   168
      TabIndex        =   3
      Top             =   768
      Width           =   1320
   End
End
Attribute VB_Name = "FTestTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private cTimers As Long
Private WithEvents wait1 As CTimer
Attribute wait1.VB_VarHelpID = -1
Private WithEvents wait2 As CTimer
Attribute wait2.VB_VarHelpID = -1
Private WithEvents wait3 As CTimer
Attribute wait3.VB_VarHelpID = -1
Private WithEvents wait4 As CTimer
Attribute wait4.VB_VarHelpID = -1
Private WithEvents wait5 As CTimer
Attribute wait5.VB_VarHelpID = -1
Private WithEvents wait6 As CTimer
Attribute wait6.VB_VarHelpID = -1
Private WithEvents wait7 As CTimer
Attribute wait7.VB_VarHelpID = -1
Private WithEvents wait8 As CTimer
Attribute wait8.VB_VarHelpID = -1
Private WithEvents wait9 As CTimer
Attribute wait9.VB_VarHelpID = -1
Private WithEvents wait10 As CTimer
Attribute wait10.VB_VarHelpID = -1

Private Sub cmdStart_Click()
    cTimers = cTimers + 1
    Select Case cTimers
    Case 1
        Set wait1 = New CTimer
        InitTimer wait1
    Case 2
        Set wait2 = New CTimer
        InitTimer wait2
    Case 3
        Set wait3 = New CTimer
        InitTimer wait3
    Case 4
        Set wait4 = New CTimer
        InitTimer wait4
    Case 5
        Set wait5 = New CTimer
        InitTimer wait5
    Case 6
        Set wait6 = New CTimer
        InitTimer wait6
    Case 7
        Set wait7 = New CTimer
        InitTimer wait7
    Case 8
        Set wait8 = New CTimer
        InitTimer wait8
    Case 9
        Set wait9 = New CTimer
        InitTimer wait9
    Case 10
        Set wait10 = New CTimer
        InitTimer wait10
    Case Else
        MsgBox "Too many timers"
    End Select
End Sub

Sub InitTimer(wait As CTimer)
    wait.Item = cTimers
    Dim i As Long
    i = CLng(txtSec) * 1000
    If i Then wait.Interval = i
End Sub

Sub CallTimer(wait As CTimer)
    Dim s As String
    s = txtOut
    s = s & "Timer " & wait.Item & " has interval " & _
            wait.Interval & vbCrLf
    txtOut = s
    txtOut.SelLength = Len(s)
End Sub

Private Sub wait1_ThatTime()
    CallTimer wait1
End Sub

Private Sub wait2_ThatTime()
    CallTimer wait2
End Sub

Private Sub wait3_ThatTime()
    CallTimer wait3
End Sub

Private Sub wait4_ThatTime()
    CallTimer wait4
End Sub

Private Sub wait5_ThatTime()
    CallTimer wait5
End Sub

Private Sub wait6_ThatTime()
    CallTimer wait6
End Sub

Private Sub wait7_ThatTime()
    CallTimer wait7
End Sub

Private Sub wait8_ThatTime()
    CallTimer wait8
End Sub

Private Sub wait9_ThatTime()
    CallTimer wait9
End Sub

Private Sub wait10_ThatTime()
    CallTimer wait10
End Sub